home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / runtime / sun2hp.el < prev    next >
Encoding:
Text File  |  1993-02-09  |  7.7 KB  |  240 lines
  1. ; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         sun2hp.el
  5. ; Description:  noddy sun to hp assembly syntax converter
  6. ; Author:       Andy Norman, Kraken (ange@hplb.hpl.hp.com)
  7. ; Created:      Mon Sep 25 16:42:20 1989
  8. ; Modified:     Wed May  2 11:23:32 1990 (Ange) ange@anorman
  9. ;
  10. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11.  
  12. ;; This file contains an extremely noddy GNU Emacs Lisp program which will
  13. ;; attempt to translate a file containing sun format assembly code into a file
  14. ;; containing the equivalent hp format assembly code.
  15. ;; Although easy to fool, it worked OK on the 0.33 njml file M68.prim.s.
  16.  
  17.  
  18. ;; label object abstraction
  19. ;;
  20. (defvar label-count 0)
  21.  
  22. (defun make-new-label ()
  23.   (format "L%d" (setq label-count (+ 1 label-count))))
  24.  
  25. (defun make-label-object (old-label)
  26.   (list 'label-object (make-new-label) old-label (dot-marker)))
  27.  
  28. (defun label-new-label (obj)
  29.   (nth 1 obj))
  30.  
  31. (defun label-old-label (obj)
  32.   (nth 2 obj))
  33.  
  34. (defun label-point (obj)
  35.   (nth 3 obj))
  36.  
  37.  
  38. ;; find-all-label-definitions -- make a scan of the buffer to find all label
  39. ;; definitions, make label-object out of each one and return the lot as a list.
  40. ;;
  41. (defun find-all-label-definitions ()
  42.   (let (label-list)
  43.     (goto-char (point-min))
  44.     (while (re-search-forward "\\<\\([0-9]+\\):" (point-max) t)
  45.       (let ((name (buffer-substring (match-beginning 1)
  46.                     (match-end 1))))
  47.     (setq label-list (cons (make-label-object name) label-list))))
  48.     label-list))
  49.  
  50.  
  51. ;; nearest-new-label -- return the new label replacement for the old label
  52. ;; given at the point given.
  53. ;;
  54. (defun nearest-new-label (name dir point labels)
  55.   (let ((nearest-distance nil)
  56.     (nearest nil))
  57.     (while labels
  58.       (let* ((cur (car labels))
  59.          (old-name (label-old-label cur)))
  60.     (if (string-equal old-name name)
  61.         (let* ((cur-point (label-point cur))
  62.            (distance (* dir (- cur-point point))))
  63.           (if (>= distance 0)
  64.           (if (or (null nearest-distance)
  65.               (< distance nearest-distance))
  66.               (progn
  67.             (setq nearest-distance distance)
  68.             (setq nearest cur)))))))
  69.       (setq labels (cdr labels)))
  70.     (label-new-label nearest)))
  71.  
  72.  
  73. ;; replace-all-references-to-labels -- change all the references to the original
  74. ;; labels to references to the new set of labels.
  75. ;;
  76. (defun replace-all-references-to-labels (labels)
  77.   (goto-char (point-min))
  78.   (while (re-search-forward "\\<\\([0-9]+\\)\\(b\\|f\\)" (point-max) t)
  79.     (let* ((name (buffer-substring (match-beginning 1)
  80.                   (match-end 1)))
  81.        (b-or-f (buffer-substring (match-beginning 2)
  82.                      (match-end 2)))
  83.        (dir (if (string-equal b-or-f "f") 1 -1))
  84.        (replacement (nearest-new-label name dir (point) labels)))
  85.       (replace-match replacement))))
  86.  
  87.  
  88. ;; replace-all-label-definitions -- change each of the old label 
  89. ;; definitions to their new value.
  90. ;;
  91. (defun replace-all-label-definitions (labels)
  92.   (while labels
  93.     (let* ((cur (car labels))
  94.        (old-label (label-old-label cur))
  95.        (point (label-point cur))
  96.        (new-label (label-new-label cur)))
  97.       (goto-char (- point 2))
  98.       (re-search-forward "\\([0-9]+\\):" (point-max) t)
  99.       (if (not (string-equal (buffer-substring (match-beginning 1)
  100.                            (match-end 1))
  101.                  old-label))
  102.       (error "label <%s> has moved" old-label)
  103.     (replace-match (concat new-label ":"))))
  104.       (setq labels (cdr labels))))
  105.  
  106.  
  107. ;; replace-re -- replace one regular expression with an interpreted string
  108. ;; throughout the whole buffer.
  109. ;;
  110. (defun replace-re (regexp to-string)
  111.   (save-excursion
  112.     (goto-char (point-min))
  113.     (while (re-search-forward regexp (point-max) t)
  114.       (replace-match to-string t nil))))
  115.  
  116.  
  117. ;; do-subst -- substitute mnemonics, register names, comment symbols etc.
  118. ;;
  119. (defun do-subst ()
  120.   (replace-re "#\\((*[-~]*[0-9]\\)" "&\\1")
  121.   (replace-re "\\(a[0-7]\\)@(\\([^)]+\\))" "\\2(\\1)")
  122.   (replace-re "\\(sp\\)@(\\([^)]+\\))" "\\2(\\1)")
  123.   (replace-re "sp@\\+" "(sp)\\+")
  124.   (replace-re "sp@-" "-(sp)")
  125.   (replace-re "sp@" "(sp)")
  126.   (replace-re "\\<sp\\>" "%sp")
  127.   (replace-re "\\(a[0-7]\\)@" "(\\1)")
  128.   (replace-re "\\(a[0-7]\\)" "%\\1")
  129.   (replace-re "\\(d[0-7]\\)" "%\\1")
  130.   (replace-re "\\(fp[0-7]\\)" "%\\1")
  131.   (replace-re "\\(fpcr\\)" "%\\1")
  132.   (replace-re "\\bcc" "%cc")
  133.   (replace-re "\\.globl" "global")
  134.   (replace-re "\\.text" "text")
  135.   (replace-re "\\.data" "data")
  136.   (replace-re "\\.long" "long")
  137.   (replace-re "\\.word" "short")
  138.   (replace-re "\\.even" "even")
  139.   (replace-re "\\.align" "lalign")
  140.   (replace-re "\\.ascii" "byte")
  141.   (replace-re "|" " #")
  142.   (replace-re "\\<movl" "mov.l")
  143.   (replace-re "\\<addqb" "addq.b")
  144.   (replace-re "\\<subqb" "subq.b")
  145.   (replace-re "\\<subw" "sub.w")
  146.   (replace-re "\\<andw" "and.w")
  147.   (replace-re "\\<cmpw" "cmp.w")
  148.   (replace-re "\\<movw" "mov.w")
  149.   (replace-re "\\<movb" "mov.b")
  150.   (replace-re "\\<lsll" "lsl.l")
  151.   (replace-re "\\<clrl" "clr.l")
  152.   (replace-re "\\<jls" "bls")
  153.   (replace-re "\\<jlt" "blt")
  154.   (replace-re "\\<jvs" "bvs")
  155.   (replace-re "\\<jpl" "bpl.w")
  156.   (replace-re "\\<cmpmb" "cmpm.b")
  157.   (replace-re "\\<orb" "or.b")
  158.   (replace-re "\\<trapls" "tls")
  159.   (replace-re "\\<lsrl" "lsr.l")
  160.   (replace-re "\\<extl" "ext.l")
  161.   (replace-re "\\<eorl" "eor.l")
  162.   (replace-re "\\<negl" "neg.l")
  163.   (replace-re "\\<negw" "neg.w")
  164.   (replace-re "\\<mulsl" "muls.l")
  165.   (replace-re "\\<divsl" "divs.l")
  166.   (replace-re "\\<divs.ll" "divsl.l")
  167.   (replace-re "\\<asrl" "asr.l")
  168.   (replace-re "\\<addl" "add.l")
  169.   (replace-re "\\<addw" "add.w")
  170.   (replace-re "\\<addql" "addq.l")
  171.   (replace-re "\\<andb" "and.b")
  172.   (replace-re "\\<andil" "andi.l")
  173.   (replace-re "\\<andl" "and.l")
  174.   (replace-re "\\<asll" "asl.l")
  175.   (replace-re "\\<asrl" "asr.l")
  176.   (replace-re "\\<clrl" "clr.l")
  177.   (replace-re "\\<cmpl" "cmp.l")
  178.   (replace-re "\\<cmpml" "cmpm.l")
  179.   (replace-re "\\<fatand" "fatan.d")
  180.   (replace-re "\\<fcmpl" "fcmp.l")
  181.   (replace-re "\\<fcmpx" "fcmp.x")
  182.   (replace-re "\\<fcosd" "fcos.d")
  183.   (replace-re "\\<fetoxd" "fetox.d")
  184.   (replace-re "\\<fgetexpd" "fgetexp.d")
  185.   (replace-re "\\<fintrzx" "fintrz.x")
  186.   (replace-re "\\<fjeq" "fbeq")
  187.   (replace-re "\\<flognd" "flogn.d")
  188.   (replace-re "\\<fmoved" "fmove.d")
  189.   (replace-re "\\<fmovel" "fmove.l")
  190.   (replace-re "\\<fsind" "fsin.d")
  191.   (replace-re "\\<fsqrtd" "fsqrt.d")
  192.   (replace-re "\\<ftstx" "ftest.x")
  193.   (replace-re "\\<flognx" "flogn.x")
  194.   (replace-re "\\<fsqrtx" "fsqrt.x")
  195.   (replace-re "\\<jbsr" "jsr")
  196.   (replace-re "\\<jcc" "bcc.w")
  197.   (replace-re "\\<jcs" "bcs.w")
  198.   (replace-re "\\<jeq" "beq.w")
  199.   (replace-re "\\<jge" "bge.w")
  200.   (replace-re "\\<jgt" "bgt.w")
  201.   (replace-re "\\<jle" "ble.w")
  202.   (replace-re "\\<jne" "bne.w")
  203.   (replace-re "\\<jra" "bra.w")
  204.   (replace-re "\\<jmi" "bmi.w")
  205.   (replace-re "\\<moveml" "movem.l")
  206.   (replace-re "\\<moveq" "movq.l")
  207.   (replace-re "\\<movl" "mov.l")
  208.   (replace-re "\\<orl" "or.l")
  209.   (replace-re "\\<subl" "sub.l")
  210.   (replace-re "\\<subql" "subq.l")
  211.   (replace-re "\\<tstl" "tst.l")
  212.   (replace-re "\\<trapmi" "tmi")
  213.   (replace-re "(%\\(..\\))-" "-(%\\1)")
  214.   (replace-re "\\<cmp.l[\t ]*\\([^,]*\\),%a\\(.\\)" "cmpa.l %a\\2,\\1")
  215.   (replace-re "\\<cmp.l[\t ]*\\([^,]*\\),%d\\(.\\)" "cmp.l %d\\2,\\1")
  216.   (replace-re "\\<cmp.w[\t ]*\\([^,]*\\),%d\\(.\\)" "cmp.w %d\\2,\\1")
  217.   (replace-re "\\<fcmp.x[\t ]*\\([^,]*\\),%fp\\(.\\)" "fcmp.x %fp\\2,\\1")
  218. )
  219.  
  220.  
  221. ;; do-convert -- the main conversion routine. Converts the file named by the
  222. ;; first arg into the file named by the second.
  223. ;;
  224. (defun do-convert (iname oname)
  225.   (find-file iname)
  226.   (setq label-count 0)
  227.   (let ((labels (find-all-label-definitions)))
  228.     (replace-all-references-to-labels labels)
  229.     (replace-all-label-definitions labels))
  230.   (do-subst)
  231.   (write-file oname))
  232.  
  233.  
  234. ;; now the code that is executed when called in batch mode.
  235. ;;
  236. (setq make-backup-files nil)
  237.  
  238. (do-convert (nth 3 command-line-args)
  239.         (nth 4 command-line-args))
  240.